perm filename PRED0.AUX[SYS,HE] blob sn#021185 filedate 1973-01-20 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	COMMON ABBREVIATIONS
C00004 00003	α YE OLDE MNEMONICS
C00006 00004	α OCCULT'S CONTEXT - FACE AND EDGE RINGS
C00007 00005	REQUIRE		"PRED1[SYS,HE]"		LOAD_MODULE
C00008 00006	REQUIRE		"PRED2[SYS,HE]"		LOAD_MODULE
C00010 00007	REQUIRE		"PRED3[SYS,HE]"		LOAD_MODULE
C00014 00008	REQUIRE		"PRED4[SYS,HE]"		LOAD_MODULE
C00016 00009	REQUIRE		"PRED5[SYS,HE]"		LOAD_MODULE
C00018 00010	REQUIRE		"DPYIII[SYS,BGB]"	LOAD_MODULE
C00021 ENDMK
C⊗;
COMMENT COMMON ABBREVIATIONS;

REQUIRE "<>||"	DELIMITERS;

DEFINE
	α = <COMMENT>,
	β=<COMMENT>,
	# = <CVN>,
	∂ = <DATUM>,
	$ = <GLOBAL>,
	∀ = <FOREACH>,
	π = <3.1415927>,
	COMMA = <&","&>,
	EOS=<)>,
	EOM=<&↓)>,
	RPAREN=<&")">,
	LPAREN=<&"("&>,
	↓ = <(13&10)>,
	TAB= <'11>,
	⊂ = <BEGIN>,
	⊃ = <END>,
	! = <DPYSET(DPYBUF)>,
	Q⊂ = <QUICK_CODE>,
	S⊂ = <START_CODE>,
	THRU= <STEP 1 UNTIL>,
	ITG= <INTEGER>,

	SUBR= <SIMPLE PROCEDURE>,
	SSUBR= <STRING SIMPLE PROCEDURE>,
	ISUBR= <INTEGER SIMPLE PROCEDURE>,
	RSUBR= <REAL SIMPLE PROCEDURE>,
	BSUBR= <BOOLEAN SIMPLE PROCEDURE>,

	XSUBR= <EXTERNAL SIMPLE PROCEDURE>,
	XISUBR= <EXTERNAL INTEGER SIMPLE PROCEDURE>,
	XRSUBR= <EXTERNAL REAL SIMPLE PROCEDURE>,
	XSSUBR= <EXTERNAL STRING SIMPLE PROCEDURE>;

α YE OLDE MNEMONICS;
ISUBR	CAR (ITG Q);	START_CODE HLRZ 1,@Q END;
ISUBR	CDR (ITG Q);	START_CODE HRRZ 1,@Q END;
SUBR	DAC (ITG N,Q);	START_CODE MOVE N; MOVEM @Q END;
SUBR	DACR(REAL X;ITG Q);START_CODE MOVE X;MOVEM @Q END;
SUBR	DAP (ITG N,Q);	START_CODE MOVE N; HRRM @Q END;
SUBR	DIP (ITG N,Q);	START_CODE MOVE N; HRLM @Q END;
ISUBR	LAC (ITG Q);	START_CODE MOVE 1,@Q END;
RSUBR	LACR(ITG Q);	START_CODE MOVE 1,@Q END;
ISUBR	NAP (ITG Q); 	START_CODE HRRE 1,@Q END;
ISUBR	NIP (ITG Q); 	START_CODE HLRE 1,@Q END;

DEFINE INCREM(A)=<A←A+1>;
DEFINE DECREM(A)=<A←A-1>;

α FATAL MESSAGE;
SUBR	FATAL (STRING S);
	⊂ OUTSTR(↓&"FATAL ERROR - "&S&↓);
	  CALL(0,"EXIT") ⊃;

α UBFEV NUMBER;
ISUBR	ITYPE (ITG X);
	RETURN(CASE(CAR(X)LAND '17)OF
	(0,1,2,0, 3,0,0,0, 4,0,0,0, 0,0,0,0));

α ENTITY TYPES;
BSUBR	BTYPE(ITG X);	RETURN((CAR(X)LAND 1)≠0);
BSUBR	FTYPE(ITG X);	RETURN((CAR(X)LAND 2)≠0);
BSUBR	ETYPE(ITG X);	RETURN((CAR(X)LAND 4)≠0);
BSUBR	VTYPE(ITG X);	RETURN((CAR(X)LAND 8)≠0);

α WORLD CONTEXT;
EXTERNAL ITG
	WORLD,BTOTAL,FTOTAL,ETOTAL,VTOTAL;

α OCCULT'S CONTEXT - FACE AND EDGE RINGS;

INTERNAL INTEGER BGND; 	α BACKGROUND FACE;
DEFINE #POTNTF=<5>;	α POTENTIALLY VISIBLE FACES;
DEFINE #POTNTE=<8>;	α POTENTIALLY VISIBLE EDGES;
DEFINE #FOLDE =<9>;	α FOLDED POTENTIALLY VISIBLE EDGES;
DEFINE #VISINC=<10>;	α VISIBLE INCOMPLETE FOLDED EDGES;

REQUIRE		"PRED1[SYS,HE]"		LOAD_MODULE;

α several functions are called from this module by the
SAIL portion of PREDICTOR:
	PROJECTOR
	EMARK
	FMARK
	EMARKALL	and more...
the module is required here for consistency and convenience;
REQUIRE		"PRED2[SYS,HE]"		LOAD_MODULE;

α OCCULTATION ROUTINES - OLD OCULT.FAI (NEW "PRED2.FAI");

XSUBR	CROSSING(REFERENCE REAL X,Y;ITG E1,E2);
XISUBR	EMPTY(ITG E,N);
XSUBR	FOLD.(ITG E);
XSUBR	HIDE.(ITG E);
XSUBR	POTEN.(ITG E);
XRSUBR	QFEV(ITG F,E,V);
XRSUBR	QEV(ITG E,V);
XSUBR	RINGIN(ITG E,Q,N);
XSUBR	RINGO(ITG E,N);
XISUBR	TJ(ITG E);
XSUBR	TJUT.(ITG E);		XISUBR TJUT(ITG E);
XSUBR	TJOT.(ITG E);		XISUBR TJOT(ITG E);
XSUBR	UFACE.(ITG Q,E,V);	XISUBR UFACE(ITG E,V);
XSUBR	VISIB.(ITG E);
XRSUBR	ZDALT (ITG F; REAL X,Y);
XRSUBR	ZDEPTH(ITG F,V);

α INTERNAL OCCULTATION ROUTINES;

BSUBR	FOLDED(ITG E);RETURN('100 LAND CAR(E));
BSUBR	VISIBLE(ITG E);RETURN('40 LAND CAR(E));
BSUBR	POTENT(ITG E);RETURN('20 LAND CAR(E));
SUBR	DEFOLD(ITG E);
	IF FOLDED(E)
	THEN ⊂	RINGO(E,#FOLDE);
		RINGO(E,#VISINC);⊃;

REQUIRE		"PRED3[SYS,HE]"		LOAD_MODULE;

α OLD WINGED.FAI - (NEW "PRED3.FAI");

α FETCH LINK FROM NODE; 
	XISUBR PART  (ITG E);	XISUBR COPART(ITG E);
	XISUBR EXTENT(ITG E);	XISUBR LOCOR (ITG E);
	XISUBR PNAME (ITG E);
	XISUBR TYPE  (ITG E);	XISUBR SERIAL(ITG E);
	XISUBR NFACE (ITG E);	XISUBR PFACE (ITG E);
	XISUBR NED   (ITG E);	XISUBR PED   (ITG E);
	XISUBR NVT   (ITG E);	XISUBR PVT   (ITG E);
	XISUBR NCW   (ITG E);	XISUBR PCW   (ITG E);
	XISUBR NCCW  (ITG E);	XISUBR PCCW  (ITG E);
	XISUBR FCNT  (ITG E);	XISUBR VCNT  (ITG E);
	XISUBR ECNT  (ITG E);	XISUBR PCNT  (ITG E);
	XISUBR NBODY (ITG E);	XISUBR PBODY (ITG E);
	XISUBR NUF   (ITG E);	XISUBR PUF   (ITG E);
	XISUBR NCNT  (ITG E);	XISUBR TJOYNT(ITG E);
	XISUBR X1DC  (ITG E);	XISUBR Y1DC  (ITG E);
	XISUBR X2DC  (ITG E);	XISUBR Y2DC  (ITG E);
	XRSUBR XDC   (ITG E);	XRSUBR YDC   (ITG E);

α STORE LINK INTO NODE; 
	XISUBR PART. (ITG Q,E);	XISUBR COPAR.(ITG Q,E);
	XISUBR EXTEN.(ITG Q,E);	XISUBR LOCOR.(ITG Q,E);
	XISUBR PNAME.(ITG Q,E);
	XISUBR TYPE. (ITG Q,E);	XISUBR SERIA.(ITG Q,E);
	XISUBR NFACE.(ITG Q,E);	XISUBR PFACE.(ITG Q,E);
	XISUBR NED.  (ITG Q,E);	XISUBR PED.  (ITG Q,E);
	XISUBR NVT.  (ITG Q,E);	XISUBR PVT.  (ITG Q,E);
	XISUBR NCW.. (ITG Q,E);	XISUBR PCW.. (ITG Q,E);
	XISUBR NCCW..(ITG Q,E);	XISUBR PCCW..(ITG Q,E);
	XISUBR FCNT. (ITG Q,E);	XISUBR VCNT. (ITG Q,E);
	XISUBR ECNT. (ITG Q,E);	XISUBR PCNT. (ITG Q,E);
	XISUBR NBODY.(ITG Q,E);	XISUBR PBODY.(ITG Q,E);
	XISUBR NUF.  (ITG Q,E);	XISUBR PUF.  (ITG Q,E);
	XISUBR NCNT. (ITG Q,E);	XISUBR TJOIN.(ITG Q,E);

α FETCH DATA FROM NODE; 

	XRSUBR AA(ITG E);  XRSUBR BB(ITG E); XRSUBR CC(ITG E);
	XRSUBR XWC(ITG E); XRSUBR YWC(ITG E); XRSUBR ZWC(ITG E);
	XRSUBR XPP(ITG E); XRSUBR YPP(ITG E); XRSUBR ZPP(ITG E);
	XRSUBR  IX(ITG E); XRSUBR  IY(ITG E); XRSUBR  IZ(ITG E);
	XRSUBR  JX(ITG E); XRSUBR  JY(ITG E); XRSUBR  JZ(ITG E);
	XRSUBR  KX(ITG E); XRSUBR  KY(ITG E); XRSUBR  KZ(ITG E);
REQUIRE		"PRED4[SYS,HE]"		LOAD_MODULE;

α OLD WINGS.FAI - (NEW "PRED4.FAI");

α DYNAMIC FREE STORAGE;
	XISUBR GETBLK(ITG SIZE);
	XSUBR  RELBLK(ITG ADDR);

α BFEV MAKE & KILL OPERATIONS;
	XISUBR MKB(ITG B);	XSUBR KLB(ITG BNEW);
	XISUBR MKF(ITG B);	XSUBR KLF(ITG B,FNEW);
	XISUBR MKE(ITG B);	XSUBR KLE(ITG B,ENEW);
	XISUBR MKV(ITG B);	XSUBR KLV(ITG B,VNEW);
	XISUBR MKBFV;		XSUBR KLBFEV(ITG Q);

α WING MAKE LINK OPERATIONS;
	XSUBR NCW.(ITG Q,E);	XSUBR PCW.(ITG Q,E);
	XSUBR NCCW.(ITG Q,E);	XSUBR PCCW.(ITG Q,E);

α ORIENTED WING FETCH & STORE OPERATIONS;
	XISUBR ECW(ITG E,Q);	XISUBR ECW.(ITG Q,E,X);
	XISUBR ECCW(ITG E,Q);	XISUBR ECCW.(ITG Q,E,X);
	XISUBR OTHER(ITG E,Q);	XISUBR OTHER.(ITG Q,E,X);

α BFV FETCH OPERATIONS;
	XISUBR BODI(ITG Q);	XISUBR MKPARTS(ITG B);
	XISUBR FCW(ITG E,V);	XISUBR FCCW(ITG E,V);
	XISUBR VCW(ITG E,F);	XISUBR VCCW(ITG E,F);

REQUIRE		"PRED5[SYS,HE]"		LOAD_MODULE;

α OLD EULER.FAI - (NEW PRED5.FAI);

α EULER SURFACE OPERATIONS;
	XSUBR INVERT(ITG E);
	XISUBR KLEV(ITG X);
	XISUBR KLFE(ITG X);
	XISUBR ESPLIT(ITG X);

REQUIRE		"DPYIII[SYS,BGB]"	LOAD_MODULE;

α DISPLAY SUBR;
	EXTERNAL PROCEDURE DPYSET(INTEGER ARRAY DPYBUF);
	EXTERNAL PROCEDURE DPYOUT(INTEGER POG);
	EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
	EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
	EXTERNAL PROCEDURE RIVECT(INTEGER X,Y);
	EXTERNAL PROCEDURE RVECT(INTEGER X,Y);
	EXTERNAL PROCEDURE HYDPOG(INTEGER POG);
	EXTERNAL PROCEDURE DPYSST(STRING S);
	EXTERNAL PROCEDURE DPYBRT(INTEGER X);
	EXTERNAL PROCEDURE DPYBIG(INTEGER SIZ);
	EXTERNAL PROCEDURE DPYCLR;


α OCCULT DISPLAY DECLARATIONS;
INTERNAL SAFE INTEGER ARRAY
	DPYBUF[1:200];
EXTERNAL INTEGER
	VERNX, VERNY;
EXTERNAL SAFE STRING ARRAY NAME[1:50];